C.S.M.P. Digest             Wed, 24 Feb 93       Volume 2 : Issue 16

Today's Topics:

	Hiliting with the hilight color??? Problem
	'aete' TMPL wanted
	Verifying valid handles, how to?
	Memory allocation in your app



The Comp.Sys.Mac.Programmer Digest is moderated by Michael A. Kelly.

The digest is a collection of article threads from the usenet newsgroup
comp.sys.mac.programmer.  It is designed for people who read c.s.m.p. semi-
regularly and want an archive of the discussions.  If you don't know what a
newsgroup is, you probably don't have access to it.  Ask your systems
administrator(s) for details.  If you don't have access to news, you can
post articles to any newsgroup by mailing your article to
	newsgroup@cs.utexas.edu
So, to post an article to comp.sys.mac.programmer, mail your article to
	comp-sys-mac-programmer@cs.utexas.edu
Note the '-' instead of '.' in the newsgroup name.  Be sure to ask that
replies be emailed to you instead of posted to the group, and give your
email address.

Each issue of the digest contains one or more sets of articles (called
threads), with each set corresponding to a 'discussion' of a particular
subject.  The articles are not edited; all articles included in this digest
are in their original posted form (as received by our news server at
cs.uoregon.edu).  Article threads are not added to the digest until the last
article added to the thread is at least one month old (this is to ensure that
the thread is dead before adding it to the digest).  Article threads that
consist of only one message are generally not included in the digest.

The entire digest is available for anonymous ftp from ftp.cs.uoregon.edu
[128.223.8.8] in the directory /pub/mac/csmp-digest.  Be sure to read the
file /pub/mac/csmp-digest/README before downloading any files.  The most
recent issues are available from sumex-aim.stanford.edu [36.44.0.6] in the
directory /info-mac/digest/csmp.  If you don't have ftp capability, the sumex
archive has a mail server; send a message with the text '$MACarch help' (no
quotes) to LISTSERV@ricevm1.rice.edu for more information.

The digest is also available via email.  Just send a note saying that you
want to be on the digest mailing list to mkelly@cs.uoregon.edu, and you will
automatically receive each new issue as it is created.  Sorry, back issues
are not available through the mailing list.

Send administrative mail to mkelly@cs.uoregon.edu.


-------------------------------------------------------

From: pcw@access.digex.com (Peter Wayner)
Subject: Hiliting with the hilight color??? Problem
Date: 21 Jan 93 14:36:01 GMT
Organization: Express Access Online Communications, Greenbelt MD USA

I've been having problems with hilighting some text using
the hilighting color. If I use the InvertRect command without
doing anything, then it is possible to toggle between regular
black on white text and inverted white on black text with
a single call to InvertRect. 

If I clear the top bit of the right part of the toolbox memory,
then I get a perfect result the first time I call InvertRect.
The text goes from black on white to black on hilight color. But
on the second call when I try to revert the text to normal, it turns
black. 

What's the trick? Why isn't it toggling?

Any help would be much apprciated. Thanks....

Peter Wayner
(pcw@access.digex.com)

+++++++++++++++++++++++++++

From: absurd@apple.apple.com (Tim Dierks, software saboteur)
Date: 21 Jan 93 16:12:49 GMT
Organization: MacDTS Marauders

In article <pcw.727626961@digex>, pcw@access.digex.com (Peter Wayner)
wrote:
> 
> I've been having problems with hilighting some text using
> the hilighting color. If I use the InvertRect command without
> doing anything, then it is possible to toggle between regular
> black on white text and inverted white on black text with
> a single call to InvertRect. 
> 
> If I clear the top bit of the right part of the toolbox memory,
> then I get a perfect result the first time I call InvertRect.
> The text goes from black on white to black on hilight color. But
> on the second call when I try to revert the text to normal, it turns
> black. 
> 
> What's the trick? Why isn't it toggling?
> 
> Any help would be much apprciated. Thanks....
> 
> Peter Wayner
> (pcw@access.digex.com)

If you're using the HiliteMode low memory global, you need to turn it
on before each and every invert call you make; it will turn itself off.
In essence, it's just a flag to say "Make the next invert call hilite".
If you want a more permanent solution (also good because it doesn't use
low memory globals), just use the hilite transfer mode; it will do
the hiliting for you and it won't turn off.

Tim Dierks
MacDTS, but I speak for myself

+++++++++++++++++++++++++++

From: rick@akbar.cc.utexas.edu (Rick Watson)
Date: 23 Jan 1993 03:17:16 GMT
Organization: University of Texas at Austin

>If I clear the top bit of the right part of the toolbox memory,
>then I get a perfect result the first time I call InvertRect.
>The text goes from black on white to black on hilight color. But
>on the second call when I try to revert the text to normal, it turns
>black. 

Did you remember to do the BitClr((Ptr)HiliteMode,pHiliteBit);
before each InvertRect? Quickdraw resets the bit after 
various calls. This is documented somewhere in the vicinity
of the description of pHiliteBit.

Rick Watson 
The University of Texas Computation Center, Networking Services, 512/471-3241
   internet: r.watson@utexas.edu             bitnet: watson@utadnx
   uucp:     ...!cs.utexas.edu!ut-emx!rick   span:   utspan::utadnx::watson

---------------------------

From: povlphp@uts.uni-c.dk (Povl H. Pedersen)
Subject: 'aete' TMPL wanted
Organization: UNI-C, Danish Computing Centre for Research and Education
Date: Wed, 20 Jan 1993 18:40:06 GMT

Subject says it all. Please mail me an aete TNPL if you have one.
I am going to start doing some AE stuff.
- -- 
Povl H. Pedersen   -   Macintosh specialist. Knows some DOS and UNIX too.
pope@imv.aau.dk    -   povlphp@uts.uni-c.dk

+++++++++++++++++++++++++++

From: ross@bnr.ca (Ross Brown)
Organization: Bell-Northern Research Ltd.
Date: Wed, 20 Jan 1993 19:33:27 GMT

In article <1993Jan20.184006.15422@uts.uni-c.dk> povlphp@uts.uni-c.dk (Povl H.
Pedersen) writes:
>Subject says it all. Please mail me an aete TNPL if you have one.
>I am going to start doing some AE stuff.
>-- 
>Povl H. Pedersen   -   Macintosh specialist. Knows some DOS and UNIX too.
>pope@imv.aau.dk    -   povlphp@uts.uni-c.dk
>

Here is the template.  It's not useful most of the time, because 'aete'
resources are too big for ResEdit to display using a template.  I have also
included a stuffed version of the Rez types file, which is more useful.

(This file must be converted with BinHex 4.0)

:"'&PG'8!FR0bBe*6483!N!J*Z%+E!*!%!3#3!`Q"!!!)J3#3!cF!!%0K$P*PB@3
J6@8J,5!b9f&jC3)!N!0849K8G(4iG!4KCA4PJ3)!N!0bFh*M8P0&4!#3#PDr!*!
%FR0bBe*6483!N"LRJa"-!*!'#EJ!N!`I!*!$3f%C9(*TB@`J9A0PFLGc)%GeD@4
P)#dJ-PGKH3)!N!0849K8G(4iG!%!!$3!N!C*!`#3"$rN!!"#!*!&!D`!!!B!T[I
M#DEr&@)!N"D0U3!,!*!+#(d@9'9YF'aKG'8J6@&UEh)J9Q9bFfP[ENK#@93@9'9
YF'aKG'8J6@PZEh)J9Q9bFfP[ENK#@94!6'&ZCh9KCf8J583J,5"cD'peE'3JBQ8
JFf&YC5"KFb"dD'Pc)(*PFfpeFQ0P)%P%)#dJ-#"QEh)J4@jRE'PcD%4A8N3,8f0
bDA"d)%0[C'9%9e*%#e0eDA4PFb"XDA0d6d019!8UN!9-8e4$#P0eDA4P)%jKE@9
38e45"f0[E@ePER438e45"5U3"8&A8N3+8h9TG'8J3fpNC94138d,8h9TG'8J6'9
fC@a%9e*%$90eDA4P)&CPFR0TEfj%9e*%#eP[GA)J4ACPER4c6d019!8UN!9-8e4
$#89fC@jd6Q&YC9"69&)(BfpYE@9ZG&"69&)&+T!&39G54!p&GQ9ZG%0XBA0c)'0
[C'986N&0$%9fC@jd583JBfpNC94138dF8Q9`E(NJ9(P`C5`JEh)JER9XE#"QEh)
JEQpZC94138d08Q9`E(NJBfpYE@9ZG&"69&)&+T!&39G54"&5CA"XH5"TFb"2F(4
TEfjKE%*#593C3f&Z)'*P)'%JD'pYEfGPEQ9[GA-JE'PcG%*#59355A-J4@jeE@9
bBA4PC#"dHA"P3N**9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9
N3N**9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0
PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593
)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593H4'PbC@0d)&"
KFQ&YCA4PFL"`FQ9QCA*PC#"dHA"P9%j"64K%DA*PBh3J8'&bB@ePG'9b)'0[E@e
PER438e45"5U3"8&A8N394'PbC@0d)&"KFQ&Y)%p`G'P[EQ&X3N**9"P$B@iJBQ8
JB5"SEfe[Cf9ZC@peFb"XDA0d3N**9"**Fb"&ER9YCA*KG'9N)(4jF'9#3NP8$%0
SB@jRC5"6G'&dC8*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRC
PC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593)FQ9
cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP
8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#594I6h4SCA)J8'&bB@ePG'9bFbiJ)%j
[G'8JG'KKG#"[FQ4PFL"TFb"cD@GZD@CTBf&ZG#`JGfKPEL"`BA*KE@9dCA*c)'&
bC5"XDA0dC@3JGfPdD'peG#"VCAPhEh*NFbj23dj8"5U3"8a69%-18'&bB@ePG'9
b)%jKE@938e45"5U3"8&A8N318'&bB@ePG'9b)%0[C'986N&0$P"KFQ&YCA4PFL"
dHA"P9%j"64&3BA*KE@9dCA)JBfpYE@9ZG&"69&)&+T!&39G54!YTCL"[F(4TEfj
KE%*#593C3f&Z)'*P)'%JD'pYEfGPEQ9[GA-JE'PcG%*#59355A-J4@jeE@9bBA4
PC#"dHA"P3N**9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N*
*9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRC
PC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593)FQ9
cCA*fC@4#3NP8#(*PFf9bGQ9N3N**9!KbCA0PFRCPC%*#593&+T!&6&08438UN!9
- -8e4&"d0XBA0cCA023dj8"5U3"8a69%-+3faKFh-J6Q&YC9"69&)&+T!&39G54!T
$E'&cFb"$Ef4P9%j"63GMEfeYC@jd8&088J8UN!9"9e*%#P"bEh"PFR4TCA023dj
8"5U3"8a69%-*8(*[F#"1B@eP8&088J8UN!9"9e*%#9"bEh!J3fpNC94138d+8(*
[F#"$E'&cFe4138d(BfpYE@9ZG&"69&)&+T!&39G54!KbCA0PFRCPC%*#593C3f&
Z)'*P)'%JD'pYEfGPEQ9[GA-JE'PcG%*#59355A-J4@jeE@9bBA4PC#"dHA"P3N*
*9!T5C@&N,eGbDA4P3N**9!KbCA0PFRCPC%*#593)FQ9cCA*fC@4#3NP8#(*PFf9
bGQ9N3N**9!KbCA0PFRCPC%*#593&+T!&4N*C9!8UN!9-8e4&#%9XC@ePER4c6d0
19!8UN!9-8e4$%N9XC@ePER3J3faKFh-J3fpNC94138d*5f9j)%C[FQec6d019!8
UN!9-8e4$#8C[FQdJ3fpNC94138d&+T!&6&08438UN!9-8e4&"5U3"8a69%883fp
YF'&bDA0[EL"2F'9bBA4[FR023dj8"5U3"8a69%-%EQ&YC9"69&)&+T!&39G54!4
MEf4P9%j"63GMEfeYC@jd8&088J8UN!9"9e*%"5U3"8a69%8*3fpZFh4KER4c6d0
19!8UN!9-8e4$$89ZG@ePFQ&dEh)J58486N&0#d9ZG@ePFQ&dEh*c6d019!8UN!9
- -8e4$$d9ZG@ePFQ&dEh)J6Q&YC9"69&)&+T!&39G54!e&ER9YCA*KG'pb)%P%9%j
"64*&ER9YCA*KG'pb)%0[E@ePER438e45"5U3"8&A8N3&+T!&6&08438UN!9-8e4
&"5U3"8a69%8!!!%!N!-*J3!!#)%!N!-h!#bI,!pZ!*!$(!!b!!"869"-!*!$#J#
!!*!(,*lX"'&PG'83RJ:

(This file must be converted with BinHex 4.0)

:#'&PG'8ZFfPd!&0*9%46593K!*!%#1J!!!&'#h96593K!!%!!!MSFNaKG3+`!*!
$&J!i$3d43899Ff9b9'9bE94jF'9c,R*%!*!0piN!N"VrN!4849K869"6)!!!TD'
`'k@KX"X!!!`#!!!bK3!!!dd!!!89RdJN!*!(Jj`d"%%5"&(R9)+)`XT'BPAV0"Y
3RTqcGlrXq2`#JYMeMXh-m1U#TZdE*2BB@'SXb65@M-SF9f`XM5qK8(**Mb'CrG)
bQL)8a5,iJG(lIHhXbcFML2D(%%3d9CT8RPHA*DQ4kFE5(L2bb`ML`)HUX951kFS
Xb5l&A'jjR%Gm5*UD%M%UIj3a2VX03B`reiba'0Cp@95c2YQ&`pTYAaBrXT!!)2E
G%K!f%Ek*B2dX5DR9Yl``"rhFZ`q,-+*@``dcMD1+#l,,M%d('8Y+miX+QlC-f#B
qHA"kXU&[GQ&HHADHX@R[j+CYQTD1,#S['0&dZ,&TDIBSBp2XdUCP)r0,QjBB5i[
+5h,-)[P0FiY+Q[BSc#[),ah*QNM0+-m[-jBf4AaprqkTQE9DXGrmM-cZ84c66%8
c&4QCkC%j4D0''3[,@-bLcLiDBFa-6Hc(Hc$l'NFE#eK23hMFbSZl["Bc-(Z-4[e
eRlT-i8Mp*Y-jjZb#l0,5TMPQTck13dP+3PDkXEKJA&0ffLFfa@6AP"F8F"'[+5V
N"%BRjjFBFmUDTQ@AS-IeaT+Qa5A'A'1*F866-K5&41ER%Y%8KR3IL90'!l+i$'H
`0+PhjSBIbjRpLmX`iq8&,$10$b0'-A$m9T@-0Sli$`"`EY,3c'(pbdCL2(C3kq+
E0NdY`P&E2c+l$11[4M+0r,Vm[-,mh2bFl-+beNh(M$3@0LfZ865c5icFX0-!01D
AiFjBhh4[ilJa+,iZrY246&Xp%()qSa3jr&'+(+M!ej2NcFrpVi,*q1R-f(R1@Be
iZ+fbDZdUm[+l4QCY`6,RR[eA89*8E#`Tbrr-3JT,Y"d)9"VJSLCR+ZiR*GfB2D*
Trm+#FIpj-"R1#"Jp#SbXrEi!-m`dNC1GAFSZaR&0HaD9M2SXEh"XPIj4Fj!!BGf
,4Z%H@Pf+*mc91$h,biT+eYV4#mf6SeI[phiMrhrAK+Z)T4#eqq%L@9P%e+jGZff
VTQXZ)5*-D&ZhGQdLJQ#)ABNGU61SNZTH[(RP[m4AmHE'Y[K-*Ij5e[FbpkY[Mke
c+b*Ca*i%L5pXLe!J!jrDjQ-rJAkEI@[cYQCeY58FYSNiir9LKL&Ue4J+XBeV)lE
6XihPCGLX0ri2!*!$$8jAmLY""M"K4QlP*k&NXqc)M"*1RN@6Nk1%Nq2d#1dLR%`
"eK0i[3"B!(PaJ#qQK"&1d)pBi#CpGRR*r$`jV518F#-mCQ6!bA-bi'6!eMLH(2k
!(AAiairJ#)dUp3$K'CU"jSAP5KSB+Ye*ck2(AF*j@K3#B@q-dX)2"M@m3*ecUB3
D65S5TN,XET8b`b%B0NDD4Mh'V,[&Kfj'aqm93rF34BdjjRfLaSI`))%m!'k!8,R
%$)MB9[Jf*aE)*XcZ&XU-$lY1YdC@8%1`ahJM*A(`8LEGAa`6rc6NY#Ld'[1-a1K
2)T0GP4HP4Ed0qh,`[k#rR43)2BDPlF(VEUGcM#F%D(&R*RR1ALS0Bp6'kF-PI,2
lc10I)C*3&iKF@K`K'4IP5("c$&r$&p[`NK9-NM(Ska2`C)L&B(*8XK(#3'8Np4a
IUja*Keja*mKJS`6B)K,8`iHlUT4@$6plAR+,j[-G'QGDX`Q%!Hq#6UF`9R-jUN9
ec"`!5*EAa0C!@HhS#Sd*2T,`5ZQX"I4M1IQm)5D)JfB#K*)MdLrK9I6fb8ie@P6
i6!D"Ba4r)%@c,U"DfrJi#VC*aJNMd6J,3a!p8S!LE'kF+k#9F9E1Z6$1KA-UHJ2
"M#m!Iq,0M(D+eZP)GB5&Q*!!5hUb&++h%cU#'h(TqNlb!24*mVj5!TRXH$C(q(2
*0@EE#C*kLZX6J5T9!kL"+86Ge)'RcN3J5T!!3'L""AeD%J9$-JVFYjJ(PJZDH@N
Xp"%BiGGN+HlY`G$"QSDUQiSHUc[%M+p8GNq@16R2,SAe*BBl6pG-X8+Vr0b"HZM
F2+'@e3&!j+L3!$cj#[UF!SjTE*acKHUm%fI!S(8Xm[Hi9Nd,j9UL$59MCp&kb$6
,c5aE-iUPJBA#MFD)[3lB&QfDXrr'E1$NYCQ'ECe),HPT,$A)dmcel[F&[JTGRlX
IBMG`hFJ4ZjP#)qhZ-99pI'i*aI1XDFE@jZHTZl6#aLN2fbMV8dAh$"JhH"IeAfi
HL[V9$Z'!E+*$XXG&3Y`N0)0TRA!Dk@3HRh4)95'Y&+Sm@%EjCC+IPrk@h%miF8`
qBXE#Ab'Za9YeN6X&Dm2&"T*#XD01fc`PDDJ(9$(5m*,*SPfm,aH,G[&EZEKZ&cI
PBY%ZVXV&4IDqkr4AU$G"[mCp'r5ALEQjC1kAm"jI9leJefhQiNif9B)iFleGp2Z
maACa-m#q-$#ElrrH+["TKlGba+&@"@V,+e0%9p4ckji83#BE#QT5iKEFmAqmY(e
G9k5%pFC4re5NH5bhTaeh25K*NkV3lcf)EC4S3L`lN!"L8QNk)1++"XJ0,!2Z4'S
BZU%I0GQj-Sh$me"df2(+6AV-[aVAQpA+KU$'&5[9qEf'S'ZPqQ)MR@c%UDSpA1B
f"U"PE+qiISH6Ej@ZPcU4E"U$eiQ9Ld4hj83V&RI#P41ckE+bP5+01CbRID-%R6!
G+X2pT46YKER-6RV9lX1KI%peadfkfN-Eid!j86dY,-NlYqf8cUHBjNE*Jf,H8DH
6kkCDiG!@aL8e"DR[CKX'5ZXC5G*mA9pV42S8L2kYb,9c8V9a*hZcbk&Q-+E$0"k
QilI+0h$"jHYQRF#82Sh'H["D%TVqYF2@1*X*fRI$VKAk4SL&Z6p)dFDMIk1Afl[
&kFRLhSP&kFm"2ai[6QJ+'((L!qrY)&4cZfMa2R&aZcJlAEbA+0`ZmZCimAlAF,X
Brr%iqceMr'GMULJ`C-*JqN[MI`!!*km!!!%!N!-"&!#3!a3!N!-b26!a-M-d06B
h!$Jj!*!$%*!4#'&PG'8ZFfPd!!)!N!06594%8dP8)3#3$&0*9%46593K!*!BTi-
4SJ#3!aB!!!&'#L#X3B"2K9@'BBTPN@Q9EjTeRhRB!+`$,3!()(j"c%k%6meKLfk
@EjX!IJF6!!!J)!F@!!!J(J!!!Vj19J!!51Irr%+R2c`!!$mm!#![2)3%!!bSY5!
I0!!f2!!"3QF[2%Y$5&+TR$JI$%3!!'F!!1i-4!!"C`!!mN*'3UF[2%Y$5!#3!a!
!+`!&!4J"qJ#3"J-!N!-"!*!$!43!N!-8!*!$-J!S)JJ2EJ#3!a`!-J!!8f9dC`#
3!`S!!2rr!*!&+'Md+AB:

==============================================================================
Ross Brown, Dept. 7C22  < Bell-Northern Research     >  Just the facts, ma'am.
Advisor, Telemgmt Svcs  < P. O. Box 3511, Station C  >  We don't care whose
ross@bnr.ca             < Ottawa, ON, Canada K1Y 4H7 >  opinions yours aren't.
==============================================================================


+++++++++++++++++++++++++++

From: andrewb@nezsdc.icl.co.nz (Andrew Bevin)
Date: Thu, 21 Jan 93 20:48:32 GMT
Organization: Fujitsu New Zealand

In article <1993Jan20.184006.15422@uts.uni-c.dk> povlphp@uts.uni-c.dk (Povl H. Pedersen) writes:
>Subject says it all. Please mail me an aete TNPL if you have one.
>I am going to start doing some AE stuff.
>-- 
>Povl H. Pedersen   -   Macintosh specialist. Knows some DOS and UNIX too.
>pope@imv.aau.dk    -   povlphp@uts.uni-c.dk

I would also, greatly appreciate an aete TNPL, if you have such a beast
please mail a copy to me as well.


- -- 
Andrew Bevin      			                     andrewb@icl.co.nz
SDC, Fujitsu New Zealand                      ## I do not speak for Fujitsu! ##
Auckland, New Zealand   
- -------------------------------------------------------------------------------

+++++++++++++++++++++++++++

From: jpm@cs.hut.fi (Jussi-Pekka Mantere)
Date: 22 Jan 93 00:29:27 GMT
Organization: Helsinki University of Technology, Finland

Povl H. Pedersen <povlphp@uts.uni-c.dk> writes:

   Subject says it all. Please mail me an aete TNPL if you have one.
   I am going to start doing some AE stuff.

You'd rather want to use an aete HyperCard stack, found on the
Developer CD's.

(Sorry, I don't have the CD handy, but will look the path up if
necessary.)

Cheers,

Jussi-Pekka Mantere

+++++++++++++++++++++++++++

From: lai@Apple.COM (Ed Lai)
Date: 23 Jan 93 15:48:43 GMT
Organization: Apple Computer Inc, Cupertino, CA

In article <JPM.93Jan22022927@cardhu.cs.hut.fi> jpm@cs.hut.fi (Jussi-Pekka Mantere) writes:
>Povl H. Pedersen <povlphp@uts.uni-c.dk> writes:
>
>   Subject says it all. Please mail me an aete TNPL if you have one.
>   I am going to start doing some AE stuff.
>
>You'd rather want to use an aete HyperCard stack, found on the
>Developer CD's.
>

You can also find the latest version (among other Apple Events related stuff)
from ftp.apple.com in the directory /pub/appleevents

>(Sorry, I don't have the CD handy, but will look the path up if
>necessary.)
>
>Cheers,
>
>Jussi-Pekka Mantere

/* Disclaimer: All statments and opinions expressed are my own */
/* Edmund K. Lai                                               */
/* Apple Computer, MS37-UP                                     */
/* 20525 Mariani Ave,                                          */
/* Cupertino, CA 95014                                         */
/* (408)974-6272                                               */
zW@h9cOi

---------------------------

From: gwatts@fnalo.fnal.gov
Subject: Verifying valid handles, how to?
Organization: Fermi National Accelerator Lab
Date: Fri, 22 Jan 1993 07:55:20 GMT

Hi all,
  The first part is an amusing story.  The second request for help is aimed
at anyone who is good at the memory manager. :)  Everyone, right? :)
  I spent about 4 hours tracking down a but in my Think C 5.0.3 program
yesterday.  It was crazy.  My color table kept getting corrupted.  I would
never bomb in the same place.  Sometimes the "rb" command in MacsBug wouldn't
even work!  I had icons explode into little dots.
  Turns out (sheepish grin) I was deleteing an object twice. :)
  At any rate, I was thinking.  I've got only indirect objects in my project.
This means every object is a handle, right?  Well, why not, in the debug
version of the message dispatcher (oopDebug library) put a little code that
will check the object is infact allocated as a handle?
  I checked out the routine in msg.c (in the oops Libraries folder), and
the handle is stored in register a1.  I don't know, however, how to check
if it is a valid handle without causing an error (bus or otherwise) of
somesort.  Especially if it is a random number!  Anyone know?  Is there
some memory manager routine, given a suspected handle, will tell me this?
  By the way -- I do zero all objects after I delete them.  This case was
a little more subtle than that (so don't yell at me :)).

	Cheers,
		Gordon.


+++++++++++++++++++++++++++

From: neeri@iis.ethz.ch (Matthias Neeracher)
Date: 22 Jan 93 18:09:34 GMT
Organization: Integrated Systems Laboratory, ETH, Zurich

In article <1993Jan22.015520.1@fnalo.fnal.gov>, gwatts@fnalo.fnal.gov writes:
>   At any rate, I was thinking.  I've got only indirect objects in my project.
> This means every object is a handle, right?  Well, why not, in the debug
> version of the message dispatcher (oopDebug library) put a little code that
> will check the object is infact allocated as a handle?
>   I checked out the routine in msg.c (in the oops Libraries folder), and
> the handle is stored in register a1.  I don't know, however, how to check
> if it is a valid handle without causing an error (bus or otherwise) of
> somesort.  Especially if it is a random number!  Anyone know?  Is there
> some memory manager routine, given a suspected handle, will tell me this?

Here you go. This code is not guaranteed to work 100% of the time, but I doubt
you will get it to produce an address error for any normal memory setup (One
exception I can think of are macs with a memory upgrade that makes the ROM
appear in the middle of the application heap).

/* Heuristic to determine whether a given address is a Handle            */
/* Based on the articles of Lloyd Lim and Matthew T Russotto in the UMPG */
/* This code may be redistributed without any restrictions               */

Boolean RealHandle(void * addr)
{
   THz   sysZone;
   THz   applZone;
   THz   heapZone;
   
   addr  =  StripAddress(addr);
   if (addr && !((long) addr & 1))  {
      sysZone  =  SystemZone();
      applZone =  ApplicZone();
      if (addr >= (Ptr) &sysZone->heapData   && 
          addr <  (Ptr) sysZone->bkLim          ||
          addr >= (Ptr) &applZone->heapData  && 
          addr <  (Ptr) applZone->bkLim
         )
         if (*(long *)addr && !(*(long *)addr & 1)) {
            heapZone =  HandleZone(addr);
            if (!MemError())
               if (heapZone == sysZone || heapZone == applZone)
                  return true;
         }
   }
   
   return false;
}

Matthias

- -----
Matthias Neeracher                                      neeri@iis.ethz.ch
 `We say "gestalt" when things combine to act in ways we can't explain'
                             -- Marvin Minsky, _The Society Of Mind_

+++++++++++++++++++++++++++

From: keith@taligent.com (Keith Rollin)
Date: 23 Jan 93 00:04:58 GMT
Organization: Taligent

In article <NEERI.93Jan22190934@iis.ethz.ch>, neeri@iis.ethz.ch (Matthias
Neeracher) wrote:
> 
> In article <1993Jan22.015520.1@fnalo.fnal.gov>, gwatts@fnalo.fnal.gov writes:
> >   At any rate, I was thinking.  I've got only indirect objects in my project.
> > This means every object is a handle, right?  Well, why not, in the debug
> > version of the message dispatcher (oopDebug library) put a little code that
> > will check the object is infact allocated as a handle?
> >   I checked out the routine in msg.c (in the oops Libraries folder), and
> > the handle is stored in register a1.  I don't know, however, how to check
> > if it is a valid handle without causing an error (bus or otherwise) of
> > somesort.  Especially if it is a random number!  Anyone know?  Is there
> > some memory manager routine, given a suspected handle, will tell me this?
> 
> Here you go. This code is not guaranteed to work 100% of the time, but I doubt
> you will get it to produce an address error for any normal memory setup (One
> exception I can think of are macs with a memory upgrade that makes the ROM
> appear in the middle of the application heap).
> 
> /* Heuristic to determine whether a given address is a Handle            */
> /* Based on the articles of Lloyd Lim and Matthew T Russotto in the UMPG */
> /* This code may be redistributed without any restrictions               */
> 
> Boolean RealHandle(void * addr)
> {
>    THz   sysZone;
>    THz   applZone;
>    THz   heapZone;
>    
>    addr  =  StripAddress(addr);
>    if (addr && !((long) addr & 1))  {
>       sysZone  =  SystemZone();
>       applZone =  ApplicZone();
>       if (addr >= (Ptr) &sysZone->heapData   && 
>           addr <  (Ptr) sysZone->bkLim          ||
>           addr >= (Ptr) &applZone->heapData  && 
>           addr <  (Ptr) applZone->bkLim
>          )
>          if (*(long *)addr && !(*(long *)addr & 1)) {
>             heapZone =  HandleZone(addr);
>             if (!MemError())
>                if (heapZone == sysZone || heapZone == applZone)
>                   return true;
>          }
>    }
>    
>    return false;
> }

I think that the above routine tries to validate any value that you might
have lying around. However, if you have a value that you know at one time
was a handle, you might want to check to see if it's on the free chain or
not (this code is from MacApp):

Boolean IsFreeHandle(Handle aHandle)
{
	THz applZone = ApplicZone();
	Handle currHandle = (Handle) applZone->hFstFree;

	while (currHandle != NULL)
	{
		if (currHandle == aHandle)
			return TRUE;
		currHandle = (Handle) * currHandle;
	}
	return FALSE;
}

If course, nothing will help you if the master pointer has been
re-allocated. Your old handle will now be pointing to a new, perfectly
valid block of memory. I think the only thing you can do at that point is
check the handle size against sizeof(TYourClass).

Greg Marriott (who was seen the other night at the Red Pepper with Cindy
Jasper) wrote an INIT that tries to detect double-dispose bugs. It's on
Apple's Developer CD and probably other places. Here are the release notes
for your reading pleasure:

;
;	DoubleTrouble - by Greg Marriott
;
;	) 1992, Apple Computer, Inc.
;
;	DoubleTrouble is a debugging utility made to catch a common programming
error:
;	freeing a handle that has already been freed.  (I call these errors
Rdouble
;	dispose bugsSI)
;
;	When _DisposeHandle is called on a handle, the memory manager adds the
handle
;	to its Rfree list,S a linked list of handles available for the allocator
to use.
;	Calling _DisposeHandle on that handle again is usually benign.  The
memory
;	manager dereferences the handle, pointing to the next handle in the free
list.
;	If the the dereferenced handle points to the first handle in a master
pointer block,
;	however, the handle appears valid because it points to a real block.  The
memory
;	manager fails to realize the block is NOT a relocatable block (all master
pointer
;	blocks are nonrelocatable), and marks it free (yikes!).  The freed master
pointer
;	block is then used in a future allocation (usually very soon after being
freed).
;	This mangles several master pointers and the free list.  Crashes soon
follow.
;
;	This kind of bug is very hard to track down, and usually difficult to
reproduce,
;	because master pointer blocks contain 64 handles (by default, some
programs
;	change this behavior).  So, this situation only comes up about 1/64th of
the
;	time.  When it happens, though, the results are inevitably catastrophic.
;
;	DoubleTrouble compares each handle being disposed to every handle in the
free list of
;	the zone containing the handle.  If the handle is already in the free
list, DoubleTrouble
;	breaks into the debugger with a message indicating whatUs going on. 
Continuing execution
;	will stuff memWZErr (WhichZone failed, -111) into MemErr and d0 and
return to the caller
;	(and NOT call through to _DisposeHandle).
;	

- -----
Keith Rollin
Phantom Programmer
Taligent, Inc.

+++++++++++++++++++++++++++

From: peter@cujo.curtin.edu.au (Peter N Lewis)
Organization: NCRPDA, Curtin University
Date: Sat, 23 Jan 1993 10:01:36 GMT

In article <1993Jan22.015520.1@fnalo.fnal.gov>, gwatts@fnalo.fnal.gov
wrote:

> the handle is stored in register a1.  I don't know, however, how to check
> if it is a valid handle without causing an error (bus or otherwise) of
> somesort.  Especially if it is a random number!  Anyone know?  Is there

here's a random attempt at it.  First check that the handle is even.  Then
check that it points to an area inside your heap or inside the system heap,
then check that h^ is inside the heap as well, and finally that recover
handle gives the right value.

 function InsideHeap (p: univ ptr; hz: THz): boolean;
 begin
  InsideHeap := (longInt(p) >= longInt(hz)) & (longInt(p) <
longInt(hz^.bkLim));
 end;

 function ValidHandle (h: univ handle): boolean;
  var
   valid: boolean;
 begin
  valid := false;
  if BAND(h, 1) = 0 then begin
   if InsideHeap(h, ApplicZone) then begin
    valid := (BAND(h^, 1) = 0) & InsideHeap(h^, ApplicZone);
   end
   else if InsideHeap(h, SystemZone) then begin
    valid := (BAND(h^, 1) = 0) & InsideHeap(h^, SystemZone);
   end;
  end;
  if valid then begin
   valid := RecoverHandle(h^) = h;
  end;
  ValidHandle := valid;
 end;

(Code tried and tested, but by no means guarenteed)

That would seem to be a good start...
   Peter.

_______________________________________________________________________
Peter N Lewis <peter@cujo.curtin.edu.au>             Ph: +61 9 368 2055

---------------------------

From: bpb9204@tamsun.tamu.edu (Brent Burton)
Subject: Memory allocation in your app
Date: 22 Jan 1993 21:49:49 -0600
Organization: Texas A&M Univ., Inc.

Just a quick question.

When your application  starts up, it gets a contiguous block of memory
in which the program has its heap and stack.

I was looking through the Mem Mgr and found out that you can create more
than one memory zone, where the NewPtr, NewHandle, and Dispose* calls
are active.  Does this mean that, for example in a compiler, you may
allocate hundreds of little chunks of memory, and then when you are
done using them, you may deallocate them all by destroying that memory
zone?  

Also, when your application exits, any chunks that were allocated from
the New* calls are automatically returned, I assume? 

The reasons I ask these are for those one-shot programming tasks
where I need to create some complex data structure, and then would
like to free it all at once.

thanks,
- -Brent
- -- 
+-------------------------+
| Brent Burton    N5VMG   |    
| bpb9204@tamsun.tamu.edu |  
+-------------------------+ 

+++++++++++++++++++++++++++

From: orpheus@reed.edu (P. Hawthorne)
Organization: Reed College, Portland, OR
Date: Sat, 23 Jan 1993 05:41:28 GMT

  bpb9204@tamsun.tamu.edu (Brent Burton) asks:
: I was looking through the Mem Mgr and found out that you can create more
: than one memory zone, where the NewPtr, NewHandle, and Dispose* calls
: are active.  Does this mean that, for example in a compiler, you may
: allocate hundreds of little chunks of memory, and then when you are
: done using them, you may deallocate them all by destroying that memory
: zone?  

  You can do this, yes. It's remarkably simple. I think Rich Siegel posted
a snippet of code that does this a couple of months ago. But, remember,
the Macintosh memory manager is not designed to handle the oodles and
oodles of blocks that your average compiler wants to deal with. If you have
the time and the inclination, you can write a dynamic memory allocator
with the same functionality as the memory manager, with remarkably
different resource requirements.

  Here's an Object Pascal class I was working on last month.  It aint
production quality, nor would it build right off the bat, but it's
informative. It was going to become the memory zone class for the framework
I've been working on, but the recent example apps I've been working on
don't need variable length blocks, so it has been left to gather dust.

  It's your basic double two-way circular linked list of free and allocated
blocks, but it doesn't use tags per se. It isn't very faithful to the sort
of allocs you generally see around, but then, it's really cool for the
stone age Macintosh memory model, so, I guess it's okay. Sometimes
reinventing the wheel can be a lot of fun! I'd like to implement the binary
free tree technique that's mentioned in an exercise in Knuth, but haven't
had time. Maybe someone else could do it. I've radically changed the
WackyHandle datatype so that it can migrate between temporary memory and
application memory at will, for instance on suspend and resume events, but
this class doesn't grok the new interface.

  Oh, by the way, it uses offsets from a handle instead of pointers so
there is some dereferencing overhead, which reflects my idiosyncratic two
cents worth on memory management. Also, it presently uses a method for
dereferencing blocks, which reflects my feelings about typing while coding
extremely dangerous and sleazy hacks like this.

  Commentary more than just welcome.

  Cut here.


Unit QPool;

Interface

Uses
 Core;

Type
 BlockO = Longint;
 BlockP = ^BlockR;
 BlockR = Record
   length: Longint;
   backBlock, nextBlock: BlockO;
   free: Boolean;
   backFree, nextFree: BlockO;
  End;
 BlockA = Array[1..256] Of BlockR;
 BlockAP = ^BlockA;
 BlockAH = ^BlockAP;

Const
 BlockRSize = Longint(SizeOf(BlockR));
 SizeOfFreeLinks = Longint(SizeOf(BlockO) + SizeOf(BlockO));
 poolHead = 0;
 freeHead = BlockRSize;
 HeaderSize = Longint(BlockRSize + BlockRSize);

Type
 QPool = Object(QContent)
   pool: BlockAH;

   presentCapacity: Longint;
   usedCapacity: Longint;
   usualCapacity: Longint;
   growthCapacity: Longint;

   freeCount: Longint;
   freeCursor: BlockO;

   usesTemporaryMemory: Boolean;

   Function QPool.Construct: Boolean;
   override;
   Procedure QPool.Destruct;
   override;
   Procedure QPool.Loosen;
   override;
   Procedure QPool.Fasten;
   override;

   Procedure QPool.Check;

   Function QPool.Ref (aBlock: BlockO): BlockP;
   Function QPool.AvailBlock (Var aBlock: BlockO; aSize: Longint): Boolean;
   Procedure QPool.ReleaseBlock (Var aBlock: BlockO);
   Procedure QPool.ChangeBlock (source, destination: BlockO);
   Procedure QPool.Compact;
  End;


Procedure QuiverTest;

Implementation

Function AvailWackyHandle (Var aHandle: Univ Handle; aSize: Longint; temporary: Boolean): Boolean;
 Var
  aResult: OSErr;
 Begin
 If temporary Then
  Begin
  aHandle := MFTempNewHandle(aSize, aResult);
  If aHandle <> Nil Then
   If Not ourMemory.AddTemporaryHandle(aHandle) Then
    Begin
    MFTempDisposHandle(aHandle, aResult);
    aHandle := Nil;
    End;
  End
 Else
  aHandle := NewHandleClear(aSize);
 AvailWackyHandle := (aHandle <> Nil);
 End;

Procedure ReleaseWackyHandle (Var aHandle: Univ Handle; temporary: Boolean);
 Var
  aResult: OSErr;
 Begin
 If temporary Then
  Begin
  MFTempDisposHandle(aHandle, aResult);
  ourMemory.RemoveTemporaryHandle(aHandle);
  End
 Else
  DisposHandle(aHandle);
 aHandle := Nil;
 End;

Procedure LockWackyHandle (aHandle: Univ Handle; temporary: Boolean);
 Var
  aResult: OSErr;
 Begin
 If temporary Then
  MFTempHLock(aHandle, aResult)
 Else
  HLock(aHandle);
 End;

Procedure UnlockWackyHandle (aHandle: Univ Handle; temporary: Boolean);
 Var
  aResult: OSErr;
 Begin
 If temporary Then
  MFTempHUnlock(aHandle, aResult)
 Else
  HUnlock(aHandle);
 End;

Function GrowWackyHandle (Var aHandle: Univ Handle; aSize: Longint; temporary: Boolean): OSErr;
 Var
  aNewHandle: Handle;
  aResult: OSErr;
  aBoolean: Boolean;
 Begin
 If temporary Then
  Begin
  aNewHandle := MFTempNewHandle(aSize, aResult);
  If aNewHandle = Nil Then
   Begin
   GrowWackyHandle := aResult;
   Exit(GrowWackyHandle);
   End;
  MFTempHLock(aNewHandle, aResult);
  MFTempHLock(aHandle, aResult);
  BlockMove(@aHandle^^, @aNewHandle^^, aSize);
  MFTempDisposHandle(aHandle, aResult);
  ourMemory.RemoveTemporaryHandle(aHandle);
  aHandle := aNewHandle;
  aBoolean := ourMemory.AddTemporaryHandle(aHandle);
  GrowWackyHandle := noErr;
  End
 Else
  GrowWackyHandle := GrowHandle(aHandle, aSize);
 End;

Procedure SizeWackyHandle (Var aHandle: Univ Handle; aSize: Longint; temporary: Boolean);
 Var
  aNewHandle: Handle;
  aResult: OSErr;
  aBoolean: Boolean;
 Begin
 If temporary Then
  Begin
  aNewHandle := MFTempNewHandle(aSize, aResult);
  If aNewHandle = Nil Then
   Exit(SizeWackyHandle);
  BlockMove(@aHandle^^, @aNewHandle^^, aSize);
  MFTempDisposHandle(aHandle, aResult);
  ourMemory.RemoveTemporaryHandle(aHandle);
  aHandle := aNewHandle;
  aBoolean := ourMemory.AddTemporaryHandle(aHandle);
  MFTempHLock(aHandle, aResult);
  End
 Else
  SizeHandle(aHandle, aSize);
 End;

Function QPool.Construct: Boolean;
 Var
  freeP, poolP, newP: BlockP;

 Begin
 Construct := false;
 If Not Inherited Construct Then
  Exit(Construct);
 If (usualCapacity > BlockRSize) & AvailWackyHandle(pool, Longint(HeaderSize + usualCapacity), usesTemporaryMemory) Then
  Begin
  LockWackyHandle(pool, usesTemporaryMemory);
  presentCapacity := HeaderSize + usualCapacity;

  poolP := Ref(poolHead);
  poolP^.backBlock := HeaderSize;
  poolP^.nextBlock := HeaderSize;

  freeP := Ref(freeHead);
  freeP^.backFree := HeaderSize;
  freeP^.nextFree := HeaderSize;
  freeP^.free := true;

  newP := Ref(HeaderSize);
  newP^.backBlock := poolHead;
  newP^.nextBlock := poolHead;
  newP^.backFree := freeHead;
  newP^.nextFree := freeHead;
  newP^.length := usualCapacity - BlockRSize;
  newP^.free := true;

  poolP^.free := false;
  poolP^.length := 0;
  freeP^.free := true;
  freeP^.length := 0;
  freeP^.nextBlock := 0;
  freeP^.backBlock := 0;

  freeCount := 1;
  freeCursor := HeaderSize;
  End
 Else If AvailWackyHandle(pool, HeaderSize, usesTemporaryMemory) Then
  Begin
  LockWackyHandle(pool, usesTemporaryMemory);
  presentCapacity := HeaderSize;

  poolP := Ref(poolHead);
  poolP^.backBlock := poolHead;
  poolP^.nextBlock := poolHead;

  freeP := Ref(freeHead);
  freeP^.backFree := freeHead;
  freeP^.nextFree := freeHead;
  freeP^.free := true;
  freeCursor := freeHead;
  End
 Else
  Exit(Construct);

 usedCapacity := HeaderSize;
 Construct := true;
 End;

Procedure QPool.Destruct;
 Begin
 ReleaseWackyHandle(pool, usesTemporaryMemory);
 Inherited Destruct;
 End;

Procedure QPool.Loosen;
 Begin
 UnlockWackyHandle(pool, usesTemporaryMemory);
 Inherited Loosen;
 End;

Procedure QPool.Fasten;
 Begin
 Inherited Fasten;
 LockWackyHandle(pool, usesTemporaryMemory);
 End;

Function QPool.Ref (aBlock: BlockO): BlockP;
 Begin
 If aBlock < 0 Then
  Debugger
 Else If aBlock > presentCapacity Then
  Debugger;
 Ref := BlockP(Clean(LongintPtr(pool)^) + aBlock);
 End;

Function QPool.AvailBlock (Var aBlock: BlockO; aSize: Longint): Boolean;
 Var
  startCursor: BlockO;
  freeCursorP: BlockP;
  leastSize, requiredSize, thisSize, newCapacity: Longint;
  aBlockP, poolP, lastP, freeP: BlockP;
  spareO: BlockO;
  spareP: BlockP;
  spareLength: Longint;
  gotExtra: Boolean;
 Begin
 aSize := aSize - SizeOfFreeLinks;
 If aSize < 0 Then
  aSize := 0;
 AvailBlock := false;

 If freeCount > 0 Then
  Begin
  leastSize := aSize + BlockRSize;
  requiredSize := leastSize + BlockRSize;

  startCursor := freeCursor;
  Repeat
   freeCursorP := Ref(freeCursor);
   If (freeCursor <> freeHead) And (Not freeCursorP^.free) Then
    Debugger;
   thisSize := freeCursorP^.length;
   If (freeCursor <> freeHead) & ((thisSize = leastSize) | (thisSize >= requiredSize)) Then
    Begin
    aBlock := freeCursor;
    usedCapacity := usedCapacity + BlockRSize + aSize;

    freeCursorP^.length := aSize;
    freeCursorP^.free := false;
    freeCount := freeCount - 1;

    spareLength := thisSize - aSize;
{If spareLength = 0 Then}
{DebugStr('Exact fit!');}
{Writeln('Exact fit at ', LongintToString(freeCursor), '.');}
{else}
{Writeln('Fit at ', LongintToString(freeCursor), '.');}

    If spareLength = 0 Then
     Begin {Cut this block out of the free list}
     Ref(freeCursorP^.backFree)^.nextFree := freeCursorP^.nextFree;
     Ref(freeCursorP^.nextFree)^.backFree := freeCursorP^.backFree;
     freeCursor := freeCursorP^.nextFree;
     End
    Else
     Begin
     spareO := freeCursor + BlockRSize + aSize;
     spareP := Ref(spareO);

{Replace this block in the free list with a new block toward the end}
     spareP^.backFree := freeCursorP^.backFree;
     spareP^.nextFree := freeCursorP^.nextFree;
     Ref(spareP^.backFree)^.nextFree := spareO;
     Ref(spareP^.nextFree)^.backFree := spareO;

{Insert this new block into the pool list}
     spareP^.nextBlock := freeCursorP^.nextBlock;
     Ref(spareP^.nextBlock)^.backBlock := spareO;
     freeCursorP^.nextBlock := spareO;
     spareP^.backBlock := freeCursor;

     spareP^.length := spareLength - BlockRsize;
     spareP^.free := true;

     freeCursor := spareO;
     freeCount := freeCount + 1;
     End;

    AvailBlock := true;
    Exit(AvailBlock);
    End
   Else
    freeCursor := freeCursorP^.nextFree;
  Until freeCursor = startCursor;
  End;

 gotExtra := (growthCapacity > BlockRSize);
 newCapacity := presentCapacity + BlockRSize + aSize + growthCapacity;
 If GrowWackyHandle(pool, newCapacity, usesTemporaryMemory) <> noErr Then
  Begin
  gotExtra := false;
  newCapacity := newCapacity - growthCapacity;
  If GrowWackyHandle(pool, newCapacity, usesTemporaryMemory) <> noErr Then
   Exit(AvailBlock);
  End;

{Writeln('Growing for ', LongintToString(presentCapacity), '.');}

 aBlock := presentCapacity;
 presentCapacity := newCapacity;
 usedCapacity := usedCapacity + BlockRSize + aSize;

 aBlockP := Ref(aBlock);
 poolP := Ref(poolHead);
 lastP := Ref(poolP^.backBlock);

 lastP^.nextBlock := aBlock;
 aBlockP^.backBlock := poolP^.backBlock;
 aBlockP^.nextBlock := poolHead;
 poolP^.backBlock := aBlock;

 aBlockP^.length := aSize;
 aBlockP^.free := false;

 If gotExtra Then
  Begin
  spareO := aBlock + BlockRSize + aBlockP^.length;
  spareP := Ref(spareO);
  spareP^.free := true;
  spareP^.length := presentCapacity - spareO - BlockRSize;

  aBlockP^.nextBlock := spareO;
  spareP^.backBlock := poolP^.backBlock;
  spareP^.nextBlock := poolHead;
  poolP^.backBlock := spareO;

  freeP := Ref(freeHead);
  spareP^.backFree := freeP^.backFree;
  spareP^.nextFree := freeHead;
  Ref(spareP^.backFree)^.nextFree := spareO;
  freeP^.backFree := spareO;

  freeCount := freeCount + 1;
  End;
 AvailBlock := true;
 End;

Procedure QPool.ReleaseBlock (Var aBlock: BlockO);
 Var
  aBlockP: BlockP;
  cursorO: BlockO;
  cursorP: BlockP;
 Begin
 aBlockP := Ref(aBlock);
 If aBlockP^.free Then
  Debugger;
 aBlockP^.free := true;

 usedCapacity := usedCapacity - BlockRSize - aBlockP^.length;

 If freeCount = 0 Then
  Begin
  cursorP := Ref(freeHead);
  cursorP^.backFree := aBlock;
  cursorP^.nextFree := aBlock;
  aBlockP^.nextFree := freeHead;
  aBlockP^.backFree := freeHead;
  End
 Else
  Begin
  cursorO := freeHead;
  cursorP := Ref(freeHead);

  If Abs(cursorP^.backFree - aBlock) <= Abs(cursorP^.nextFree - aBlock) Then
   Begin {Scan backward from head of free list}
   If (freeCursor > aBlock) Then
    cursorP := Ref(freeCursor);
   Repeat
    cursorO := cursorP^.backFree;
    cursorP := Ref(cursorO);
   Until (cursorO < aBlock) | (cursorO = freeHead);
   End
  Else
   Begin {Scan foreward from head of free list}
   If (freeCursor < aBlock) Then
    cursorP := Ref(freeCursor);
   Repeat
    cursorO := cursorP^.nextFree;
    cursorP := Ref(cursorO);
   Until (cursorO > aBlock) | (cursorO = freeHead);
   cursorO := cursorP^.backFree;
   cursorP := Ref(cursorO);
   End;

  aBlockP^.nextFree := cursorP^.nextFree;
  Ref(aBlockP^.nextFree)^.backFree := aBlock;
  aBlockP^.backFree := cursorO;
  cursorP^.nextFree := aBlock;

  If cursorP^.nextBlock = aBlock Then
   Begin
{Writeln('Joining ', LongintToString(cursorO), ' to ', LongintToString(aBlock), '.');}
   cursorP^.length := cursorP^.length + BlockRSize + aBlockP^.length;
   cursorP^.nextFree := aBlockP^.nextFree;
   Ref(cursorP^.nextFree)^.backFree := cursorO;
   cursorP^.nextBlock := aBlockP^.nextBlock;
   Ref(cursorP^.nextBlock)^.backBlock := cursorO;

   aBlock := cursorO;
   aBlockP := cursorP;
   freeCount := freeCount - 1;
   End;

  If aBlockP^.nextBlock = aBlockP^.nextFree Then
   Begin
{Writeln('Merging ', LongintToString(aBlock), ' with ', LongintToString(aBlockP^.nextFree), '.');}
   cursorP := Ref(aBlockP^.nextFree);
   aBlockP^.length := aBlockP^.length + BlockRSize + cursorP^.length;
   aBlockP^.nextFree := cursorP^.nextFree;
   Ref(aBlockP^.nextFree)^.backFree := aBlock;
   aBlockP^.nextBlock := cursorP^.nextBlock;
   Ref(aBlockP^.nextBlock)^.backBlock := aBlock;
   freeCount := freeCount - 1;
   End;
  End;

 freeCount := freeCount + 1;

 If (aBlock > usualCapacity) & (aBlockP^.nextBlock = poolHead) Then
  Begin
{Writeln('Truncating at ', LongintToString(aBlock), '.');}

  freeCount := freeCount - 1;

  Ref(freeHead)^.backFree := aBlockP^.backFree;
  Ref(aBlockP^.backFree)^.nextFree := freeHead;

  Ref(poolHead)^.backBlock := aBlockP^.backBlock;
  Ref(aBlockP^.backBlock)^.nextBlock := poolHead;

  freeCursor := Ref(freeHead)^.nextFree;

  presentCapacity := aBlock;
  SizeWackyHandle(pool, presentCapacity, usesTemporaryMemory);

  End
 Else
  freeCursor := aBlock;

 aBlock := 0;
 End;

Procedure QPool.Check;
 Var
  previousO, cursorO: BlockO;
  previousP, cursorP: BlockP;
  totalFree: Longint;
 Begin

 If usedCapacity < 0 Then
  Debugger;

 If freeCount < 0 Then
  Debugger;

{Check pool list}
 cursorO := poolHead;
 cursorP := Ref(poolHead);

 Repeat
  previousO := cursorO;
  previousP := cursorP;
  cursorO := cursorP^.nextBlock;
  cursorP := Ref(cursorO);
  If cursorP^.backBlock <> previousO Then
   Debugger;
 Until cursorO = poolHead;

{Check free list}
 If freeCount = 0 Then
  Begin
  If usedCapacity <> presentCapacity Then
   Nothing;
  End
 Else
  Begin
  cursorO := freeHead;
  cursorP := Ref(freeHead);

  totalFree := 0;
  Repeat
   previousO := cursorO;
   previousP := cursorP;
   cursorO := cursorP^.nextFree;
   cursorP := Ref(cursorO);
   If cursorO <> freeHead Then
    totalFree := totalFree + cursorP^.length + BlockRSize;
   If cursorP^.backFree <> previousO Then
    Debugger;
   If cursorP^.nextFree = cursorP^.nextBlock Then
    Debugger;
  Until cursorO = freeHead;

  If Abs(totalFree - (presentCapacity - usedCapacity)) > 0 Then
   Debugger;
  End;
 End;

Procedure QPool.ChangeBlock (source, destination: BlockO);
 Var
  a: Longint;
 Begin
{if source <> destination then}
{for a := 1 to N do}
{if offsets[a] = source then}
{begin}
{offsets[a] := destination;}
{Leave;}
{end;}
 End;

Procedure QPool.Compact;
 Var
  FreeP, PoolP: BlockP;
  TargetO, StartO, FinishO, NextTargetO, CursorO, NextCursorO: BlockO;
  TargetP, StartP, FinishP, NextTargetP, CursorP: BlockP;
  Delta, Length: Longint;

 Begin
 FreeP := Ref(freeHead);
 PoolP := Ref(poolHead);

 FreeCursor := freeHead;

 While (FreeP^.nextFree <> freeHead) & (PoolP^.backBlock <> FreeP^.nextFree) Do
  Begin
  TargetO := FreeP^.nextFree;
  TargetP := Ref(TargetO);

  StartO := TargetP^.nextBlock;
  StartP := Ref(StartO);

  NextTargetO := TargetP^.nextFree;
  If NextTargetO = freeHead Then
   NextTargetO := poolHead;
  NextTargetP := Ref(NextTargetO);

  FinishO := Ref(NextTargetO)^.backBlock;
  FinishP := Ref(FinishO);

  CursorO := StartO;
  CursorP := StartP;
  Delta := TargetO - StartO;
  Length := 0;
  Repeat
   Length := Length + BlockRSize + CursorP^.length;
   ChangeBlock(CursorO, CursorO + Delta);

   CursorP^.backBlock := CursorP^.backBlock + Delta;
   CursorO := CursorP^.nextBlock;
   CursorP^.nextBlock := CursorP^.nextBlock + Delta;
   CursorP := Ref(CursorO);
  Until CursorO = NextTargetO;

  CursorO := TargetO + Length;
  CursorP := Ref(CursorO);
  StartP^.backBlock := TargetP^.backBlock;
  FinishP^.nextBlock := CursorO;

  BlockMove(Ptr(StartP), Ptr(TargetP), Length);

  CursorP^.length := Abs(Delta);
  If NextTargetO <> poolHead Then
   CursorP^.length := CursorP^.length + NextTargetP^.length;
{BlockRSize added and subtracted to CursorP^.length}
  CursorP^.free := true;

  CursorP^.backBlock := FinishO + Delta;
  CursorP^.backFree := freeHead;
  FreeP^.nextFree := CursorO;

  If NextTargetO = poolHead Then
   Begin
   CursorP^.nextFree := freeHead;
   FreeP^.backFree := CursorO;

   CursorP^.nextBlock := poolHead;
   PoolP^.backBlock := CursorO;
   End
  Else
   Begin
   CursorP^.nextFree := NextTargetP^.nextFree;
   Ref(CursorP^.nextFree)^.backFree := CursorO;

   CursorP^.nextBlock := NextTargetP^.nextBlock;
   Ref(CursorP^.nextBlock)^.backBlock := CursorO;

   FreeCount := FreeCount - 1;
   End;
  End;

 If (PresentCapacity > UsualCapacity) & (FreeP^.backFree = PoolP^.backBlock) Then
  Begin
  CursorO := FreeP^.backFree;
  CursorP := Ref(CursorO);

{Writeln('Shortening at ', LongintToString(CursorO), '.');}

  FreeP^.backFree := CursorP^.backFree;
  Ref(CursorP^.backFree)^.nextFree := freeHead;

  PoolP^.backBlock := CursorP^.backBlock;
  Ref(CursorP^.backBlock)^.nextBlock := poolHead;

  presentCapacity := CursorO;
  SizeWackyHandle(Pool, PresentCapacity, usesTemporaryMemory);

  FreeCount := FreeCount - 1;
  End;

 End;

Procedure QuiverTest;
 Const
  N = 2500;
  MinimumLength = 12;
  MaximumLength = 24;

  iterationsBeforeReport = 4096;

 Var
  offsets: Array[1..N] Of BlockO;
  sizes: Array[1..N] Of Longint;

  epoch: Longint;

  aPool: QPool;
  a, e, i: Longint;
  aBlock: BlockO;
  aBlockP: BlockP;
  aStringP: StringPtr;
  anEvent: EventRecord;

 Begin
 ShowText;
 DebugStr('You must uncomment the ChangeBlock method.');

 For a := 1 To 4 Do
  randseed := randseed * TickCount * Random;
{randseed := Longint(-230814419);}
 Writeln('randseed = ', LongintToString(randseed));
 Writeln;

 New(aPool);
 aPool.Dub('The Pool We Are Testing.');
 aPool.usesTemporaryMemory := true;
 aPool.usualCapacity := Trunc(n * (BlockRSize + (minimumLength + maximumLength) / 2));
 aPool.growthCapacity := 1000;
 If Not aPool.Construct Then
  Exit(QuiverTest);

 i := aPool.usedCapacity;
 For a := 1 To N Do
  Begin
  e := MonteCarlo(MinimumLength, MaximumLength);
  i := i + e + BlockRSize;
  If Not aPool.AvailBlock(aBlock, e) Then
   Debugger;
  aBlockP := aPool.Ref(aBlock);
  If aBlockP^.free Then
   Debugger;
  aStringP := StringPtr(Clean(aBlockP) + BlockRSize - SizeOfFreeLinks);
  aStringP^ := LongintToString(Longint(e - SizeOfFreeLinks));
  offsets[a] := aBlock;
  sizes[a] := e;
  If i <> aPool.usedCapacity Then
   Nothing;
{aPool.Check;}
  End;

 Repeat
  e := MonteCarlo(1, N);

  aBlock := offsets[e];
  aBlockP := aPool.Ref(aBlock);

  If aBlock <> 0 Then
   Begin
{Writeln('Releasing ', LongintToString(aBlock), '.');}
   aStringP := StringPtr(Clean(aBlockP) + BlockRSize - SizeOfFreeLinks);
   If aStringP^ <> LongintToString(aBlockP^.length) Then
    Debugger;

   aPool.ReleaseBlock(offsets[e]);
   If offsets[e] <> 0 Then
    Debugger;
   sizes[e] := 0;
   End
  Else
   Begin
   i := MonteCarlo(MinimumLength, MaximumLength);
   If Not aPool.AvailBlock(offsets[e], i) Then
    If Not aPool.AvailBlock(offsets[e], i) Then
     Debugger;
{Writeln('Created ', LongintToString(offsets[e]), '.');}
   If offsets[e] = 0 Then
    Debugger;
   aBlockP := aPool.Ref(offsets[e]);
   aStringP := StringPtr(Clean(aBlockP) + BlockRSize - SizeOfFreeLinks);
   aStringP^ := LongintToString(Longint(i - SizeOfFreeLinks));
   sizes[e] := i;
   End;

{aPool.Check;}
{Writeln;}

  GetKeys;

  epoch := epoch + 1;
  If epoch > iterationsBeforeReport Then
   Begin
{If Button Then}
   Begin
   Write('CompactingI ');
   aPool.usualCapacity := aPool.usedCapacity;
   aPool.Compact;
   Write('Done. ');
   End;

   Writeln(PercentageToString(Percentage(aPool.usedCapacity, aPool.presentCapacity)), ' used.');
{aPool.Check;}
   epoch := 0;

   SystemTask;
   aPool.Loosen;
   If WaitNextEvent(everyEvent, anEvent, 3000, Nil) Then
    Nothing;
   aPool.Fasten;
   End;

  If epoch Mod (iterationsBeforeReport Div 4) = 0 Then
   Begin
   aPool.Loosen;
   If WaitNextEvent(everyEvent, anEvent, 0, Nil) Then
    Nothing;
   aPool.Fasten;
   End;

 Until SpaceKey;

 aPool.Destruct;
 End;

End.

---------------------------

End of C.S.M.P. Digest
**********************